################
#PSRM: Explaining Support for Redistribution: Social Insurance Systems and Fairness
#
#Experimental Data
#Figure 4
#
#Verena Fetscher
#July 2022
####################



##########################
#Load data file
##########################

load("dataLab_SocialInsurance_complete.Rda")


##########################
#Filter for decision-makers
##########################

dfSub<-df[df$Role==1,]


##########################
#Subgroups
##########################

#Segregate types
types<-aggregate(rep(1, length(paste0(dfSub$give_weight,dfSub$ID,dfSub$Role))),
                 by=list(dfSub$give_weight,dfSub$ID,dfSub$Role), sum)
filter(types,Group.3==1)

length(filter(types,Group.1==0&Group.3==1&x>=5)$Group.2)
length(filter(types,Group.1==0&Group.3==1&x>=8)$Group.2)
length(filter(types,Group.1==0&Group.3==1&x>=16)$Group.2)

x<-filter(types,Group.1==0&Group.3==1&x>=5)
x$Group.2


##########################
#Other-regarding decision-makers
##########################

#remove decision-makers with 4 or more zero transfers from data set
dfSub_other<-dfSub[!(dfSub$ID %in% x$Group.2),] 
length(unique(dfSub_other$ID))

dfSub %>%
  filter(!(dfSub$ID %in% x$Group.2)) %>%
  group_by(ID) %>%
  summarize(mean= mean(give_weight))-> mydf_other

summary(mydf_other$mean)
sd(mydf_other$mean)



##########################
#Comparison benefit-level principle
##########################


#Comparison 1
#Situations
#2-9

length(unique(dfSub_other$ID))
sit1<-dfSub_other$situation==2
sit2<-dfSub_other$situation==9


s1 <- dfSub_other$give_weight[sit1]
s2 <- dfSub_other$give_weight[sit2]


mean(dfSub_other$give_weight[sit1],na.rm=T)-
mean(dfSub_other$give_weight[sit2],na.rm=T)


#Nonparametric test statistics
p<-wilcoxsign_test(s1~s2,data=dfSub_other,
                   distribution="exact") 

p<-paste("p =",as.character(round(pvalue(p),4)), sep=" ")



g1<-ggplot(data=dfSub_other[sit1|sit2,], 
       aes(x=factor(situation), give_weight))+
  geom_boxplot(aes(fill=factor(situation)),width=.5,alpha=.8)+
  stat_summary(fun.y = mean, geom="point",color="black",size=3) +
  stat_summary(fun.y=mean, colour="black", geom="text", show_guide= FALSE, 
               vjust=-.7, aes( label=round(..y.., digits=2))) +
  ylab("Inequality-reduction in %") +  xlab ("")+ ylim(c(0,200))+
  ggtitle("(a) Absolute\n endowment")+
  theme_minimal()+
  scale_fill_manual(values=c("#CCCCCC","#666666"), 
                   name="",
                   breaks=c("2","9"),
                   labels=c("earnings-related",
                             "flat-rate"))+
  guides(fill=guide_legend(nrow=2,byrow=TRUE))+
  annotate("text", x=1.5, y=117.5, label= p,size=5)+
  theme_bw()+
  theme(panel.border=element_blank(),axis.line=element_line(),
        plot.title = element_text(size=20),
        legend.text = element_text(size = 18),
        legend.title = element_text(size=18),
        axis.text=element_text(size=18),
        axis.title=element_text(size=18),
        axis.text.x = element_blank(),
        axis.text.y=element_text(size=18),
        legend.position="none"
  )


#Comparison 2
#Situations
#8-13

sit1<-dfSub_other$situation==8
sit2<-dfSub_other$situation==13

s1 <- dfSub_other$give_weight[sit1]
s2 <- dfSub_other$give_weight[sit2]


mean(dfSub_other$give_weight[sit1],na.rm=T)-
mean(dfSub_other$give_weight[sit2],na.rm=T)


#Nonparametric test statistics
p<-wilcoxsign_test(s1~s2,data=dfSub_other,
                   distribution="approximate") 

p<-paste("p =",as.character(round(pvalue(p),4)), sep=" ")

g2<-ggplot(data=dfSub_other[sit1|sit2,], 
       aes(x=factor(situation), give_weight))+
  #geom_violin()+
  geom_boxplot(aes(fill=factor(situation)),width=.5,alpha=.8)+
  stat_summary(fun.y = mean, geom="point",color="black",size=3) +
  stat_summary(fun.y=mean, colour="black", geom="text", show_guide= FALSE, 
               vjust=-.7, aes( label=round(..y.., digits=2))) +
  ylab("") +  xlab ("")+ 
  ggtitle("(b) Inequality and\nhigh replacement")+ylim(c(0,200))+
  scale_fill_manual(values=c("#CCCCCC","#666666"), 
                    name="",
                    breaks=c("8","13"),
                    labels=c("earnings-related",
                             "flat-rate"))+
  guides(fill=guide_legend(nrow=2,byrow=TRUE))+
  annotate("text", x=1.5, y=117.5, label= p,size=5)+
  theme_bw()+
  theme(panel.border=element_blank(),axis.line=element_line(),
        plot.title = element_text(size=20),
        legend.text = element_text(size = 18),
        legend.title = element_text(size=18),
        axis.text=element_text(size=18),
        axis.title=element_text(size=18),axis.text.x = element_blank(),axis.text.y=element_blank(),
        legend.position="none"
  )


#Comparison 3
#Situations
#6-13

sit1<-dfSub_other$situation==6
sit2<-dfSub_other$situation==13

s1 <- dfSub_other$give_weight[sit1]
s2 <- dfSub_other$give_weight[sit2]


mean(dfSub_other$give_weight[sit1],na.rm=T)-
mean(dfSub_other$give_weight[sit2],na.rm=T)


#nonparametric test statistics
p<-wilcoxsign_test(s1~s2,data=dfSub_other,
                   distribution="exact") 

p<-paste("p =",as.character(round(pvalue(p),4)), sep=" ")


g3<-ggplot(data=dfSub_other[sit1|sit2,], 
       aes(x=factor(situation), give_weight))+
  geom_boxplot(aes(fill=factor(situation)),width=.5,alpha=.8)+
  stat_summary(fun.y = mean, geom="point",color="black",size=3) +
  stat_summary(fun.y=mean, colour="black", geom="text", show_guide= FALSE, 
               vjust=-.7, aes( label=round(..y.., digits=2))) +
  ylab("") +  xlab ("")+ ylim(c(0,200))+
  ggtitle("(c) Inequality and\nlow replacement")+
  theme_minimal()+
  scale_fill_manual(values=c("#CCCCCC","#666666"), 
                    name="",
                    breaks=c("6","13"),
                    labels=c("earnings-related",
                             "flat-rate"))+
  guides(fill=guide_legend(nrow=2,byrow=TRUE))+
  annotate("text", x=1.5, y=117.5, label= p,size=5)+
  theme_bw()+
  theme(panel.border=element_blank(),axis.line=element_line(),
        plot.title = element_text(size=20),
        legend.text = element_text(size = 18),
        legend.title = element_text(size=18),
        axis.text=element_text(size=18),
        axis.title=element_text(size=18),
        axis.text.x = element_blank(),
        axis.text.y=element_blank(),
        legend.position="none"
  )



#Produces Figure 4: Effect of social insurance principle on transfers.
ggarrange(g1,g2, g3,common.legend = TRUE, legend="bottom",ncol = 3)


ggsave(file="figure_4.pdf", height = 5.83, width = 8.27, units = "in")


